
#|_____________________________________________________________________
 |                                                                     |
 | vismenu2.lsp                                                        |
 | OPTIONS, FILE, AND EDIT menus                                       |
 | Copyright (c) 1991-2002 by Forrest W. Young                         |
 |_____________________________________________________________________|  
 |#

(enable-container *desktop-container*)

(setf *var-window* nil)
(setf *obs-window* nil)
(setf *max-workmap-item* nil)
(setf *max-datasheet-item* nil)
(setf *restore-desktop* nil)
(setf *desktop-menu* (send menu-proto :new "DeskTop"))


;----------------
;OPTIONS MENU 
;----------------

(defvar *command-menu* (send menu-proto :new "Options"))
     

(defun change-preferences () (preferences))

(setf command-menu-startup-item
        (send expert-menu-item-proto :new "Preferences ..."
              :action 'preferences))

(setf command-menu-clock-item
        (send expert-menu-item-proto :new "Show Clock"
              :action 'show-clock))

(setf command-menu-clock-options-item
        (send expert-menu-item-proto :new "Clock Options"
              :action 'clock-options))

(defun vista-twiddle () (desktop-twiddle))

(setf command-menu-twiddle-item
        (send expert-menu-item-proto :new "ViSta Twiddle"
              :action 'vista-twiddle))

(defun start-it-up () 
  (system (strcat *default-path* "vista.exe"))
  (exit))  

(defun change-font () (font))

(defun repair-font () (reinstall-font))

(setf command-menu-repair-font-item
      (send expert-menu-item-proto :new "Repair Font"
              :action 'repair-font))

(defun renew-filetypes () (set-filetypes))

(setf command-menu-repair-filetypes-item
      (send expert-menu-item-proto :new "Renew FileTypes"
              :action 'renew-filetypes))

(setf command-menu-change-font-item
      (send expert-menu-item-proto :new "Change Font"
              :action 'change-font))

(setf command-menu-config-excel-item
      (send expert-menu-item-proto :new "Configure Excel ..."
              :action 'configure-excel))

(setf command-menu-developers-item
      (send expert-menu-item-proto :new "Developers Mode"
            :action 'toggle-devel-mode))

(setf command-menu-show-screen-saver-item
      (send expert-menu-item-proto :new "Show Screen Saver" :enabled nil
            :action 'show-screen-saver))

(setf command-menu-screen-saver-options-item
      (send expert-menu-item-proto :new "Screen Saver ..." :enabled nil
            :action 'screen-saver-options))

(setf command-menu-screen-saver-item
      (send expert-menu-item-proto :new "Screen Saver ..." :enabled nil
            :action 'screen-saver-options))

(setf stop-all-plots-command-menu-item
      (send expert-menu-item-proto :new "Stop All Plots" :enabled t
            :action 'stop-all-plots))

(setf command-menu-toplevel-item
#+macintosh(select (send *command-menu* :items) 3)
#-macintosh(send expert-menu-item-proto :new "Refresh System" :action #'refresh-system)
   )

(defun record-listener ()
  (cond	
    ((send command-menu-double-dribble-item :mark)
     (double-dribble)
     (send command-menu-double-dribble-item :mark nil))
    (t (let ((f 
#-X11  (set-file-dialog "Listener file:")
#+X11  (file-save-dialog  "Std. Output file:" "*.txt" "." "double-dribble.txt")
              ))
         (when f
               (double-dribble f)
               (send command-menu-double-dribble-item :mark t))))))




(setf command-menu-double-dribble-item
      (send expert-menu-item-proto :new "Record Listener" :enabled t
            :action 'record-listener))

#+macintosh(defun show-listener () (send *listener* :show-window))

#+macintosh(setf listener-menu-item (select (send *command-menu* :items) 0))
#+macintosh(setf dash1 (select (send *command-menu* :items) 1))
#+macintosh(setf cleanup (select (send *command-menu* :items) 2))
#+macintosh(setf dash2 (select (send *command-menu* :items) 4))
#+macintosh(setf double-dribble (select (send *command-menu* :items) 5))
#+macintosh(setf repeat (select (send *command-menu* :items) 6))
#+macintosh(send *command-menu* :delete-items
                 listener-menu-item dash1 cleanup command-menu-toplevel-item 
                 dash2 double-dribble repeat)

(setf command-menu-run-excel-item
      (send expert-menu-item-proto :new "Run Excel ..."
              :action 'run-excel))

(defun sending-vista-data-to-excel ()
  (from-vista-to-excel))

(setf command-menu-send-data-to-excel-item
      (send expert-menu-item-proto :new "Send Data To Excel ..."
              :action 'sending-vista-data-to-excel))

(defun bug-list ()
  (send *vista* :file-to-help-window (strcat *help-dir-name* "bug-list.hlp") "Bug List" *help-window*))

(setf bug-list-menu-item
      (send expert-menu-item-proto :new "Bug List"
            :action 'bug-list))

(defun install-command-menu ()
  (unless *command-menu*
          (setf *command-menu* (send menu-proto :new "Options")))
  (install-command-menu-items))


(defun install-command-menu-items ()
  (let ((nitems (length (send *command-menu* :items))))
    (when (> nitems 0)
          (apply #'send *command-menu* :delete-items
                 (send *command-menu* :items)))
    
    (when *change-profiles*
          (send *command-menu* :append-items
                command-menu-startup-item
               ; command-menu-font-item
                (send dash-item-proto :new)))
    (when *change-excess*
          (send *command-menu* :append-items
                command-menu-run-excel-item
              ;  command-menu-send-data-to-excel-item
                (send dash-item-proto :new)))
   ; (when *enable-screen-saver-feature*
   ;       (send *command-menu* :append-items
   ;             command-menu-screen-saver-item
   ;             command-menu-show-screen-saver-item
   ;             ))
    (send *command-menu* :append-items
          command-menu-clock-item
          command-menu-clock-options-item
          command-menu-twiddle-item
          (send dash-item-proto :new)
          command-menu-double-dribble-item
          (send dash-item-proto :new)
          command-menu-repair-font-item
          command-menu-repair-filetypes-item
          command-menu-toplevel-item)
    (when *pro-version*
          (send *command-menu* :append-items
                (send dash-item-proto :new)
                command-menu-developers-item))
    (when (> (length (send *command-menu* :items)) 0) 
          (setf *command-menu-installed* t)
          (send *command-menu* :install))
    ))

(install-command-menu)

(defmeth *command-menu* :update-items ()
  (install-command-menu-items))

;the following are not used by the menus any longer
;but may be used elsewhere (some definitely are)

(defun run-access () (configure-access))

(defun configure-access ()
  (message-dialog "Not Working in this Release"))

(setf command-menu-config-access-item
      (send expert-menu-item-proto :new "Configure Access ..."
              :action 'configure-access))

(defun run-access ()
  (message-dialog "Not Working in this Release"))

(setf command-menu-run-access-item
      (send expert-menu-item-proto :new "Run Access ..."
              :action 'run-access))

(setf command-menu-workmap-item
      (send expert-menu-item-proto :new "Show WorkMap"
            :action #'(lambda () (send *workmap* :gui t))))

(setf command-menu-refresh-spreadplot-item
      (send expert-menu-item-proto :new "Refresh SpreadPlot" :enabled nil
            :action 'refresh-spreadplot))

(setf command-menu-refresh-item
      (send expert-menu-item-proto :new "Refresh DeskTop"
            :action 'refresh-desktop))

(setf command-menu-resize-item
      (send expert-menu-item-proto :new "Resize DeskTop ..."
            :action 'resize-desktop))

(defun spreadplot-options ()
  (send *vista* :spreadplot-options))

(setf command-menu-spreadplot-options-item
      (send expert-menu-item-proto :new "SpreadPlot Options ..."
            :action 'spreadplot-options))

(setf command-menu-directories-item
      (send expert-menu-item-proto :new "Change Directories ..."
              :action 'change-directories))

(setf command-menu-author-item
      (send expert-menu-item-proto :new "Author GuideMaps"
            :action 'author-guidemaps))


(defun change-menus () (privileges))

(setf command-menu-configure-item
      (send expert-menu-item-proto :new "Change Menus ..."
              :action 'privileges))

(defun change-directories ()
  (set-working-directory *startup-dir-name*)
  (setf *font-setting-mode* nil)
  (setf *directory-setting-mode* t)
  (load (strcat *runtime-dir-name* "config"))
  (setf *font-setting-mode* t))


;(setf command-menu-font-item
;      (send expert-menu-item-proto :new "Change Fonts ..."
;              :action 'change-fonts))

(defun change-fonts ()
  (setf *font-setting-mode* t)
  (setf *directory-setting-mode* nil)
  (load (strcat *runtime-dir-name* "config"))
  (setf *directory-setting-mode* t))


;----------------
;FILE MENU 
;----------------

(setf new-data-file-menu-item
      (send expert-menu-item-proto :new "New Data ..." :key #\N  
            :action 'new-data))

(setf open-data-file-menu-item
      (send expert-menu-item-proto :new "Open Data ..." :key #\O ;fwy 4.28
            :action 'open-data))

(setf open-archived-data-file-menu-item
      (send expert-menu-item-proto :new "Open Archived Data ..." ;fwy 6.1
            :action 'open-archived-data))

(setf import-data-file-menu-item
      (send expert-menu-item-proto :new "Import Data ..." ;fwy 4.28
            :action 'import-data))

(setf new-edit-file-menu-item
      (send expert-menu-item-proto :new "New Edit ..."
            :action 'new-edit))

(setf open-edit-file-menu-item
      (send expert-menu-item-proto :new "Open Edit ..."
            :action 'open-edit))

(setf simulate-data-file-menu-item
      (send expert-menu-item-proto :new "Simulate Data ..." ;fwy 4.28
            :action 'simulate-data))

(setf export-data-file-menu-item
      (send expert-menu-item-proto :new "Export Data ..." :enabled nil
            :action 'export-data))

(defun send-data-to-excel ()
  (send *current-data* :send-data-to-excel))

(setf send-data-to-excel-menu-item
      (send expert-menu-item-proto :new "Send Data to Excel" :enabled nil
            :action 'send-data-to-excel))

(setf fake-print-file-menu-item
      (send expert-menu-item-proto :new "Print" :key #\P ;fwy 4.32
            :action 'print-output))

(setf save-text-file-menu-item
      (send expert-menu-item-proto :new "Save Text ..." :enabled nil
            :action 'save-text))



;;RAF 7/29/95
#+macintosh (setf close-window-menu-item
                  (send menu-item-proto :new "Close Window" :key  #\W
                        :action
                        #'(lambda ()
                            (let* (
                                   (fw (front-window))
                                   )
                              (if (send fw :has-method ':close)
                                  (send fw :close)) )) ))

;;RAF 7/29/95
#+macintosh (defmeth close-window-menu-item :update ()
              (let (
                    (fw (front-window))
                    )
                (if fw
                    (send self :enabled (send fw :has-method ':close))
                    (send self :enabled nil) )) )

#+macintosh (defun close-window ()
              (send close-window-menu-item :do-action))

(defun load-script () (load-edit))

(setf load-edit-menu-item
      (send expert-menu-item-proto :new "Load Edit ..." :key #\L
            :action #'(lambda () (load-edit))))

(setf run-program-menu-item
      (send expert-menu-item-proto :new "Load Script ..."
            :action #'(lambda () (load-script))))

#+macintosh 	
(defun mac-file-menu ()
   (defvar *file-menu* (send menu-proto :new "File"))

   (defproto file-edit-item-proto '(message) '() menu-item-proto)

   (defmeth file-edit-item-proto :isnew (title message &rest args)
     (setf (slot-value 'message) message)
     (apply #'call-next-method title args))
  
   (defmeth file-edit-item-proto :do-action ()
     (send (front-window) (slot-value 'message)))
   
   (defmeth file-edit-item-proto :update ()
     (send self :enabled (kind-of-p (front-window) edit-window-proto)))
   
   (let ((file-menu-items (send *file-menu* :items))
         )
     (apply #'send *file-menu* ':delete-items file-menu-items)
     (send *file-menu* :append-items
           new-data-file-menu-item    ;new data 0
           open-data-file-menu-item   ;open data 1
           simulate-data-file-menu-item ;simulate data 2
           import-data-file-menu-item ;import data 5
           load-model-menu-item       ;load model  3
           (send dash-item-proto :new)
           save-data-menu-item ;9
           export-data-file-menu-item
           save-model-menu-item ;10
           (send dash-item-proto :new) ;11
           (send menu-item-proto :new "New Edit" 
                 :action #'(lambda () (send edit-window-proto :new)))
           (send menu-item-proto :new "Open Edit" 
                 :action #'(lambda ()
                             (send edit-window-proto :new :bind-to-file t)))
           load-edit-menu-item
           (send dash-item-proto :new)
           (send file-edit-item-proto :new "Save Edit" :save :key #\S)
           (send file-edit-item-proto :new "Save Edit As" :save-as)
           (send file-edit-item-proto :new "Save Edit Copy" :save-copy)
           (send file-edit-item-proto :new "Revert Edit" :revert)
           (send dash-item-proto :new);17
           fake-print-file-menu-item
           close-window-menu-item
           (select file-menu-items 10));quit
     ))
#+macintosh(mac-file-menu)

#|
(defun print-program ()
    (let ((dir (get-working-directory))
          (file))
      (set-working-directory *user-path*)
      (unless *printer.exe*
              (setf *printer.exe*
                    (probe-file "c:\\program files\\windows nt\\accessories\\wordpad.exe")))
      (when *printer.exe* 
            (setf file (open-file-dialog))
            (system (strcat *printer.exe* " /p " file ))))
      (set-working-directory dir))
|#

(defun print-program ()
     (print-datacode (open-file-dialog)))


 
(defun print-file ()
  (let* ((file (open-file-dialog)))
    (if file
        (system (format nil "notepad.exe /p ~a" file))
        nil)))

(defun msdos-file-menu ()
  (cond
    (*ni*
     (apply #'send *file-menu* :delete-items (send *file-menu* :items))
     (send *file-menu* :append-items
           new-edit-file-menu-item
           open-edit-file-menu-item
           load-edit-menu-item
           (send dash-item-proto :new)
           (send expert-menu-item-proto :new "Exit" :action #'msw-exit)
           )
     
     (defvar *vista-file-menu* (send menu-proto :new "File"))
     (send *vista-file-menu* :append-items
           new-data-file-menu-item
           open-data-file-menu-item
           simulate-data-file-menu-item   
           (send dash-item-proto :new)
           import-data-file-menu-item
           export-data-file-menu-item
           (send dash-item-proto :new)
           save-data-menu-item
           save-model-menu-item
           (send dash-item-proto :new)
           (send expert-menu-item-proto :new "New Edit..."
                 :action 'new-edit)
           (send expert-menu-item-proto :new "Open Edit ..."
                 :action 'open-edit)
	   (send expert-menu-item-proto :new "Load Edit ..." :key #\L
                 :action #'(lambda () (load-edit)))
           (send dash-item-proto :new)
           (send expert-menu-item-proto :new "Print File ..."
                 :action #'print-file)
          ; (send dash-item-proto :new)
; dkent print-file-menu-item 
           (send expert-menu-item-proto :new "Print Active Pane..." :action #'msw-print)	
           (send expert-menu-item-proto :new "Print Entire Window"  :action #'msw-container-print)	
; dkent page-setup menu item
          ; (send menu-item-proto :new "Page Setup..." :action #'msw-pagesetup)
           (send dash-item-proto :new)	
           (send expert-menu-item-proto :new "Exit"  :action #'close-exit)
           )
     (send *vista-file-menu* :install)
     )
    (t
     (send *file-menu* :append-items
           new-data-file-menu-item
           open-data-file-menu-item
           
           simulate-data-file-menu-item
           load-model-menu-item
           (send dash-item-proto :new)
           import-data-file-menu-item
           export-data-file-menu-item
           send-data-to-excel-menu-item
           (send dash-item-proto :new)
           save-data-menu-item
           save-model-menu-item
           save-text-file-menu-item
           (send dash-item-proto :new)
           new-edit-file-menu-item
           open-edit-file-menu-item
           load-edit-menu-item
           (send dash-item-proto :new)
; dkent print-file-menu-item 
           (send expert-menu-item-proto :new "Print..." :action #'msw-print)		
; dkent page-setup menu item
           (send expert-menu-item-proto :new "Page Setup..." :action #'msw-pagesetup)
           (send dash-item-proto :new)	
           (send expert-menu-item-proto :new "Exit" :action #'vista-exit))
     (send *file-menu* :install))))

#+msdos(msdos-file-menu)

(defun x11-file-menu ()
  (apply #'send *file-menu* ':delete-items (send *file-menu* :items))
  (send *file-menu* :append-items
        new-data-file-menu-item
        open-data-file-menu-item
        simulate-data-file-menu-item
        (send dash-item-proto :new)
        export-data-file-menu-item
        import-data-file-menu-item
        (send dash-item-proto :new)
        save-data-menu-item 
        save-model-menu-item
        save-text-file-menu-item
        (send dash-item-proto :new)
        load-data-menu-item
        load-model-menu-item
        load-edit-menu-item
        (send dash-item-proto :new)
        (send menu-item-proto :new "Quit" :action #'quit)
        (send menu-item-proto :new "About XLISP-STAT ..." :action #'about-xlisp-stat)
        (send menu-item-proto :new "About ViSta ..." :action #'about-vista))
  (send *file-menu* :install))
#+X11 (x11-file-menu)

;----------------
; EDIT MENU
;----------------


(setf search-replace-menu-item
      (send expert-menu-item-proto :new "Search-Replace..."
            :action #'(lambda () (dialog-search-replace)) :enabled t))

(setf *vista-edit-menu* (send menu-proto :new "&Edit"))

(setf *edit-menu-items*
      (list
       (send menu-item-proto :new "Cu&t\tCtrl+X" :action #'msw-cut)
       (send menu-item-proto :new "&Copy\tCtrt+C" :action #'msw-copy)
       (send menu-item-proto :new "&Paste\tCtrl+V" :action #'msw-paste)
       (send menu-item-proto :new "C&lear\tDel" :action #'msw-clear)
       (send dash-item-proto :new)
       (send menu-item-proto :new "Copy-Paste\tAlt+V"
     	      :action #'msw-copy-paste)
       (send dash-item-proto :new)))

(apply #'send *vista-edit-menu* :append-items *edit-menu-items*)
     
(send *vista-edit-menu* :install)

(defun initialize-msdos-file-menu ()
  (send new-edit-file-menu-item :enabled t)
  (send open-edit-file-menu-item :enabled t)
  (send load-edit-menu-item :enabled t)
  (send new-data-file-menu-item :enabled nil)
  (send open-data-file-menu-item :enabled t)
  (send simulate-data-file-menu-item :enabled t)
  (send import-data-file-menu-item :enabled t)
  (send export-data-file-menu-item :enabled nil)
  (send save-data-menu-item :enabled nil)
  (send save-model-menu-item :enabled nil)
  )

(defun initialize-msdos-menus ()
  (initialize-msdos-file-menu)
  )

(provide "vismenu2")
